home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / kcl.lha / lsp / listlib.c < prev    next >
C/C++ Source or Header  |  1987-06-04  |  10KB  |  456 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "listlib.h"
  5. init_listlib(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     base[0]= VV[0];
  9.     (void)simple_symlispcall_no_event(VV[1],base+0,1);
  10.     MF(VV[2],L2,start,size,data);
  11.     MF(VV[3],L3,start,size,data);
  12.     MF(VV[4],L4,start,size,data);
  13.     MF(VV[5],L5,start,size,data);
  14.     MF(VV[6],L6,start,size,data);
  15.     MF(VV[7],L7,start,size,data);
  16.     MF(VV[8],L8,start,size,data);
  17.     MF(VV[9],L9,start,size,data);
  18.     MF(VV[10],L10,start,size,data);
  19.     vs_top=vs_base=base;
  20. }
  21. /*    function definition for UNION    */
  22.  
  23. static L2()
  24. {    register object *base=vs_base;
  25.     register object *sup=base+VM3;
  26.     vs_reserve(VM3);
  27.     if(vs_top-vs_base<2) too_few_arguments();
  28.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  29.     vs_top=sup;
  30.     if((base[0])!=Cnil){
  31.     goto T4;}
  32.     vs_top=(vs_base=base+1)+1;
  33.     return;
  34. T4:;
  35.     base[9]=symbol_function(VV[14]);
  36.     base[10]= car(base[0]);
  37.     base[11]= base[1];
  38.     {object V1;
  39.     V1= base[2];
  40.      vs_top=base+12;
  41.      while(!endp(V1))
  42.      {vs_push(car(V1));V1=cdr(V1);}
  43.     vs_base=base+10;}
  44.     funcall_no_event(base[9]);
  45.     vs_top=sup;
  46.     if((vs_base[0])==Cnil){
  47.     goto T7;}
  48.     base[9]= cdr(base[0]);
  49.     base[10]= base[1];
  50.     {object V2;
  51.     V2= base[2];
  52.      vs_top=base+11;
  53.      while(!endp(V2))
  54.      {vs_push(car(V2));V2=cdr(V2);}
  55.     vs_base=base+9;}
  56.     L2();
  57.     return;
  58. T7:;
  59.     {object V3= car(base[0]);
  60.     base[10]= cdr(base[0]);
  61.     base[11]= base[1];
  62.     {object V4;
  63.     V4= base[2];
  64.      vs_top=base+12;
  65.      while(!endp(V4))
  66.      {vs_push(car(V4));V4=cdr(V4);}
  67.     vs_base=base+10;}
  68.     L2();
  69.     vs_top=sup;
  70.     base[9]= vs_base[0];
  71.     base[10]= make_cons(V3,base[9]);
  72.     vs_top=(vs_base=base+10)+1;
  73.     return;}
  74. }
  75. /*    function definition for NUNION    */
  76.  
  77. static L3()
  78. {    register object *base=vs_base;
  79.     register object *sup=base+VM4;
  80.     vs_reserve(VM4);
  81.     if(vs_top-vs_base<2) too_few_arguments();
  82.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  83.     vs_top=sup;
  84.     if((base[0])!=Cnil){
  85.     goto T20;}
  86.     vs_top=(vs_base=base+1)+1;
  87.     return;
  88. T20:;
  89.     base[9]=symbol_function(VV[14]);
  90.     base[10]= car(base[0]);
  91.     base[11]= base[1];
  92.     {object V5;
  93.     V5= base[2];
  94.      vs_top=base+12;
  95.      while(!endp(V5))
  96.      {vs_push(car(V5));V5=cdr(V5);}
  97.     vs_base=base+10;}
  98.     funcall_no_event(base[9]);
  99.     vs_top=sup;
  100.     if((vs_base[0])==Cnil){
  101.     goto T23;}
  102.     base[9]= cdr(base[0]);
  103.     base[10]= base[1];
  104.     {object V6;
  105.     V6= base[2];
  106.      vs_top=base+11;
  107.      while(!endp(V6))
  108.      {vs_push(car(V6));V6=cdr(V6);}
  109.     vs_base=base+9;}
  110.     L3();
  111.     return;
  112. T23:;
  113.     base[10]= cdr(base[0]);
  114.     base[11]= base[1];
  115.     {object V7;
  116.     V7= base[2];
  117.      vs_top=base+12;
  118.      while(!endp(V7))
  119.      {vs_push(car(V7));V7=cdr(V7);}
  120.     vs_base=base+10;}
  121.     L3();
  122.     vs_top=sup;
  123.     base[9]= vs_base[0];
  124.     if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
  125.     (base[0])->c.c_cdr = base[9];
  126.     vs_top=(vs_base=base+0)+1;
  127.     return;
  128. }
  129. /*    function definition for INTERSECTION    */
  130.  
  131. static L4()
  132. {    register object *base=vs_base;
  133.     register object *sup=base+VM5;
  134.     vs_reserve(VM5);
  135.     if(vs_top-vs_base<2) too_few_arguments();
  136.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  137.     vs_top=sup;
  138.     if((base[0])!=Cnil){
  139.     goto T36;}
  140.     base[9]= Cnil;
  141.     vs_top=(vs_base=base+9)+1;
  142.     return;
  143. T36:;
  144.     base[9]=symbol_function(VV[14]);
  145.     base[10]= car(base[0]);
  146.     base[11]= base[1];
  147.     {object V8;
  148.     V8= base[2];
  149.      vs_top=base+12;
  150.      while(!endp(V8))
  151.      {vs_push(car(V8));V8=cdr(V8);}
  152.     vs_base=base+10;}
  153.     funcall_no_event(base[9]);
  154.     vs_top=sup;
  155.     if((vs_base[0])==Cnil){
  156.     goto T39;}
  157.     {object V9= car(base[0]);
  158.     base[10]= cdr(base[0]);
  159.     base[11]= base[1];
  160.     {object V10;
  161.     V10= base[2];
  162.      vs_top=base+12;
  163.      while(!endp(V10))
  164.      {vs_push(car(V10));V10=cdr(V10);}
  165.     vs_base=base+10;}
  166.     L4();
  167.     vs_top=sup;
  168.     base[9]= vs_base[0];
  169.     base[10]= make_cons(V9,base[9]);
  170.     vs_top=(vs_base=base+10)+1;
  171.     return;}
  172. T39:;
  173.     base[9]= cdr(base[0]);
  174.     base[10]= base[1];
  175.     {object V11;
  176.     V11= base[2];
  177.      vs_top=base+11;
  178.      while(!endp(V11))
  179.      {vs_push(car(V11));V11=cdr(V11);}
  180.     vs_base=base+9;}
  181.     L4();
  182.     return;
  183. }
  184. /*    function definition for NINTERSECTION    */
  185.  
  186. static L5()
  187. {    register object *base=vs_base;
  188.     register object *sup=base+VM6;
  189.     vs_reserve(VM6);
  190.     if(vs_top-vs_base<2) too_few_arguments();
  191.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  192.     vs_top=sup;
  193.     if((base[0])!=Cnil){
  194.     goto T52;}
  195.     base[9]= Cnil;
  196.     vs_top=(vs_base=base+9)+1;
  197.     return;
  198. T52:;
  199.     base[9]=symbol_function(VV[14]);
  200.     base[10]= car(base[0]);
  201.     base[11]= base[1];
  202.     {object V12;
  203.     V12= base[2];
  204.      vs_top=base+12;
  205.      while(!endp(V12))
  206.      {vs_push(car(V12));V12=cdr(V12);}
  207.     vs_base=base+10;}
  208.     funcall_no_event(base[9]);
  209.     vs_top=sup;
  210.     if((vs_base[0])==Cnil){
  211.     goto T55;}
  212.     base[10]= cdr(base[0]);
  213.     base[11]= base[1];
  214.     {object V13;
  215.     V13= base[2];
  216.      vs_top=base+12;
  217.      while(!endp(V13))
  218.      {vs_push(car(V13));V13=cdr(V13);}
  219.     vs_base=base+10;}
  220.     L5();
  221.     vs_top=sup;
  222.     base[9]= vs_base[0];
  223.     if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
  224.     (base[0])->c.c_cdr = base[9];
  225.     vs_top=(vs_base=base+0)+1;
  226.     return;
  227. T55:;
  228.     base[9]= cdr(base[0]);
  229.     base[10]= base[1];
  230.     {object V14;
  231.     V14= base[2];
  232.      vs_top=base+11;
  233.      while(!endp(V14))
  234.      {vs_push(car(V14));V14=cdr(V14);}
  235.     vs_base=base+9;}
  236.     L5();
  237.     return;
  238. }
  239. /*    function definition for SET-DIFFERENCE    */
  240.  
  241. static L6()
  242. {    register object *base=vs_base;
  243.     register object *sup=base+VM7;
  244.     vs_reserve(VM7);
  245.     if(vs_top-vs_base<2) too_few_arguments();
  246.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  247.     vs_top=sup;
  248.     if((base[0])!=Cnil){
  249.     goto T68;}
  250.     base[9]= Cnil;
  251.     vs_top=(vs_base=base+9)+1;
  252.     return;
  253. T68:;
  254.     base[9]=symbol_function(VV[14]);
  255.     base[10]= car(base[0]);
  256.     base[11]= base[1];
  257.     {object V15;
  258.     V15= base[2];
  259.      vs_top=base+12;
  260.      while(!endp(V15))
  261.      {vs_push(car(V15));V15=cdr(V15);}
  262.     vs_base=base+10;}
  263.     funcall_no_event(base[9]);
  264.     vs_top=sup;
  265.     if((vs_base[0])!=Cnil){
  266.     goto T71;}
  267.     {object V16= car(base[0]);
  268.     base[10]= cdr(base[0]);
  269.     base[11]= base[1];
  270.     {object V17;
  271.     V17= base[2];
  272.      vs_top=base+12;
  273.      while(!endp(V17))
  274.      {vs_push(car(V17));V17=cdr(V17);}
  275.     vs_base=base+10;}
  276.     L6();
  277.     vs_top=sup;
  278.     base[9]= vs_base[0];
  279.     base[10]= make_cons(V16,base[9]);
  280.     vs_top=(vs_base=base+10)+1;
  281.     return;}
  282. T71:;
  283.     base[9]= cdr(base[0]);
  284.     base[10]= base[1];
  285.     {object V18;
  286.     V18= base[2];
  287.      vs_top=base+11;
  288.      while(!endp(V18))
  289.      {vs_push(car(V18));V18=cdr(V18);}
  290.     vs_base=base+9;}
  291.     L6();
  292.     return;
  293. }
  294. /*    function definition for NSET-DIFFERENCE    */
  295.  
  296. static L7()
  297. {    register object *base=vs_base;
  298.     register object *sup=base+VM8;
  299.     vs_reserve(VM8);
  300.     if(vs_top-vs_base<2) too_few_arguments();
  301.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  302.     vs_top=sup;
  303.     if((base[0])!=Cnil){
  304.     goto T84;}
  305.     base[9]= Cnil;
  306.     vs_top=(vs_base=base+9)+1;
  307.     return;
  308. T84:;
  309.     base[9]=symbol_function(VV[14]);
  310.     base[10]= car(base[0]);
  311.     base[11]= base[1];
  312.     {object V19;
  313.     V19= base[2];
  314.      vs_top=base+12;
  315.      while(!endp(V19))
  316.      {vs_push(car(V19));V19=cdr(V19);}
  317.     vs_base=base+10;}
  318.     funcall_no_event(base[9]);
  319.     vs_top=sup;
  320.     if((vs_base[0])!=Cnil){
  321.     goto T87;}
  322.     base[10]= cdr(base[0]);
  323.     base[11]= base[1];
  324.     {object V20;
  325.     V20= base[2];
  326.      vs_top=base+12;
  327.      while(!endp(V20))
  328.      {vs_push(car(V20));V20=cdr(V20);}
  329.     vs_base=base+10;}
  330.     L7();
  331.     vs_top=sup;
  332.     base[9]= vs_base[0];
  333.     if(type_of(base[0])!=t_cons)FEwrong_type_argument(Scons,base[0]);
  334.     (base[0])->c.c_cdr = base[9];
  335.     vs_top=(vs_base=base+0)+1;
  336.     return;
  337. T87:;
  338.     base[9]= cdr(base[0]);
  339.     base[10]= base[1];
  340.     {object V21;
  341.     V21= base[2];
  342.      vs_top=base+11;
  343.      while(!endp(V21))
  344.      {vs_push(car(V21));V21=cdr(V21);}
  345.     vs_base=base+9;}
  346.     L7();
  347.     return;
  348. }
  349. /*    function definition for SET-EXCLUSIVE-OR    */
  350.  
  351. static L8()
  352. {    register object *base=vs_base;
  353.     register object *sup=base+VM9;
  354.     vs_reserve(VM9);
  355.     if(vs_top-vs_base<2) too_few_arguments();
  356.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  357.     vs_top=sup;
  358.     base[10]= base[0];
  359.     base[11]= base[1];
  360.     {object V22;
  361.     V22= base[2];
  362.      vs_top=base+12;
  363.      while(!endp(V22))
  364.      {vs_push(car(V22));V22=cdr(V22);}
  365.     vs_base=base+10;}
  366.     L6();
  367.     vs_top=sup;
  368.     base[9]= vs_base[0];
  369.     base[11]= base[1];
  370.     base[12]= base[0];
  371.     {object V23;
  372.     V23= base[2];
  373.      vs_top=base+13;
  374.      while(!endp(V23))
  375.      {vs_push(car(V23));V23=cdr(V23);}
  376.     vs_base=base+11;}
  377.     L6();
  378.     vs_top=sup;
  379.     base[10]= vs_base[0];
  380.     base[11]= append(base[9],base[10]);
  381.     vs_top=(vs_base=base+11)+1;
  382.     return;
  383. }
  384. /*    function definition for NSET-EXCLUSIVE-OR    */
  385.  
  386. static L9()
  387. {    register object *base=vs_base;
  388.     register object *sup=base+VM10;
  389.     vs_reserve(VM10);
  390.     if(vs_top-vs_base<2) too_few_arguments();
  391.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  392.     vs_top=sup;
  393.     base[10]= base[0];
  394.     base[11]= base[1];
  395.     {object V24;
  396.     V24= base[2];
  397.      vs_top=base+12;
  398.      while(!endp(V24))
  399.      {vs_push(car(V24));V24=cdr(V24);}
  400.     vs_base=base+10;}
  401.     L6();
  402.     vs_top=sup;
  403.     base[9]= vs_base[0];
  404.     base[11]= base[1];
  405.     base[12]= base[0];
  406.     {object V25;
  407.     V25= base[2];
  408.      vs_top=base+13;
  409.      while(!endp(V25))
  410.      {vs_push(car(V25));V25=cdr(V25);}
  411.     vs_base=base+11;}
  412.     L7();
  413.     vs_top=sup;
  414.     base[10]= vs_base[0];
  415.     base[11]= nconc(base[9],base[10]);
  416.     vs_top=(vs_base=base+11)+1;
  417.     return;
  418. }
  419. /*    function definition for SUBSETP    */
  420.  
  421. static L10()
  422. {    register object *base=vs_base;
  423.     register object *sup=base+VM11;
  424.     vs_reserve(VM11);
  425.     if(vs_top-vs_base<2) too_few_arguments();
  426.     parse_key(vs_base+2,TRUE,FALSE,3,VV[11],VV[12],VV[13]);
  427.     vs_top=sup;
  428.     base[9]= base[0];
  429. T116:;
  430.     if((base[9])!=Cnil){
  431.     goto T117;}
  432.     base[10]= Ct;
  433.     vs_top=(vs_base=base+10)+1;
  434.     return;
  435. T117:;
  436.     base[10]=symbol_function(VV[14]);
  437.     base[11]= car(base[9]);
  438.     base[12]= base[1];
  439.     {object V26;
  440.     V26= base[2];
  441.      vs_top=base+13;
  442.      while(!endp(V26))
  443.      {vs_push(car(V26));V26=cdr(V26);}
  444.     vs_base=base+11;}
  445.     funcall_no_event(base[10]);
  446.     vs_top=sup;
  447.     if((vs_base[0])!=Cnil){
  448.     goto T121;}
  449.     base[10]= Cnil;
  450.     vs_top=(vs_base=base+10)+1;
  451.     return;
  452. T121:;
  453.     base[9]= cdr(base[9]);
  454.     goto T116;
  455. }
  456.